HPAVC/HPAVC CD-ROM.iso/SNOW00.ZIP/SNOW.PAS

Pascal/Delphi Source File | 1996-11-13 | 4KB | 148 lines

{  SNOW demo by Rafhel.  This is my first attempt to do a graphics demo.          }
{  It is very simple to do this demo, and I know there are better ways to code it.}
{  I've made it thanx to Denthor's VGA tutorials.                                 }
{  The documentation is not too good; I hope it is helpful to other people who,   }
{  like me, is starting on fascinating world of coding!!!! :) .   I'm trying to   }
{  build up a programming group, so if you are interested   (no matter what part  }
{  of the world you are), contact me at [e-mail] .   }
{  Copyright 1996 : Rafhel.  }
{  Notice:  You're using this program at your own risk. }

program neva;
uses crt;
 const
   nm = 28;  {the number of elements in TABLA}
   nm2 = 5;   { every nm2 times, the flake's x-movement is updated (see below) }
   vga = $a000;
   numcopos = 50; { number of flakes visualized}
   ffact = 15;     { This variable helps with delaying the demo }

type
  matriz = array[1..nm] of integer;

  copo = record   {  flake's atributes}
    x,y,x0 : integer;
    xold,yold : integer;
    lim : integer;
    factor : integer;
    factor2 : integer;
    vibra : integer;
    color : byte;
    esc : byte;
    edad : integer;   {  edad is the "life" of the flake.  When it finishes its fall,}
  end;                { the flake still vibrates for a while (thanx to edad) so }
                      {if it finds a lower place, it'll fall onto it.}
                      { This makes a more "real" snow floor }
  nevada = array[1..numcopos] of copo;
const
   tabla : matriz = (1,2,2,2,2,3,3,3,3,2,2,2,2,1,-1,-2,-2,-2,-2,-3,-3,-3,-3,-2,-2,-2,-2,-1);

{ matriz is a very-simple sin table (used in flake's x-movement) }

var
  pr : longint;
  i,o : integer;
  nieve : nevada; {nieve is snow in spanish...}
                  { nevada is snowstorm }

procedure iniciar (var nevada0 : copo);
var
  cole : byte;
begin
  with nevada0 do begin
  if random(100) < 10 then cole :=7 else cole :=30;  { Choose between two colors}
    y:=0;
    x0:=random(310)+5;
    xold:=x;
    yold:=y;
    lim:=20;
    factor:=lim;
    factor2:=ffact;
    esc := nm2;
    edad:=random(500);
    vibra:=random(nm);
    x:=x0;
    color:=cole;
  end;
end;



procedure setvga; assembler;
asm
   mov ax,0013h
   int 10h
end;

{ procedure escalar is used in the flake's x-movement. }


procedure escalar( var esc2 : byte; var vibra2 : integer);
begin
  dec(esc2);
  if esc2=0 then begin esc2:=nm2;inc(vibra2);
    if vibra2=nm then vibra2:=0;
  end;
end;

procedure settext; assembler;
asm
  mov ax,0003h;
  int 10h;
end;


procedure pokevga(xx,yy : longint; valor : byte);
begin
  mem[vga:yy*320+xx]:=valor;
end;


function getpixel(x,y: longint) : boolean;  { Indicates if a pixel is on }
begin
  pr:=y*320+x;
  getpixel:=not(mem[vga:pr]=0);
end;

begin
  randomize;
  for i:=1 to numcopos do  begin
    iniciar(nieve[i]);
    nieve[i].y:=random(200);
  end;
  setvga;
  for i:=10 to 200 do pokevga(i,90,1);
  while not keypressed do begin
    for i:=1 to numcopos do
      with nieve[i]  do begin
        if random(100)<5 then begin  {this helps in making the snow floor more "real"}
        escalar(esc,vibra);
        x:=x0+tabla[vibra];
      end;

      dec(factor);                       { I wanted the flakes to do a free-fall }
      if factor=0 then begin              {movement.  Playing around with the values of}
      factor:=lim;                         {lim, nm2 and ffact helps understanding}
      dec(factor2);                         {the algorithm.  Of course, I know}
      if factor2=0 then begin dec(lim);   {there are other better ways to do the job,}
        if lim=0 then lim:=1;              {but I used the first idea that came to my head}
        factor2:=ffact;
      end;

      if getpixel(x,y+1) or (y > 198) then begin  {this part finds out wether the}
         dec(edad);                            {snowflake has finished its fall.}
         if edad=0 then iniciar(nieve[i]);
      end else begin
        escalar(esc,vibra);
        x:=x0+tabla[vibra];
        inc(y);
        pokevga(xold,yold,0);
        pokevga(x,y,color);
        xold:=x; yold:=y;
      end;
    end;
  end;
 end;
 settext;

end.